COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	Font file definitions and procedures: FIND_FONT, READ_FONT_FILE, PRELOAD_FONTS
C00023 ENDMK
C⊗;
Comment Font file definitions and procedures: FIND_FONT, READ_FONT_FILE, PRELOAD_FONTS;

define pxl = 1, tfm = 2; gf = 3;! File types we will read;
define pxlppn={"[PXL,SYS]"};	! Default PPN for PXL files;
define tfmppn={"[TEX,SYS]"};	! Default PPN for TFM files;
define gfppn={"[ GF,SYS]"};	! Default PPN for GF files;

integer fontchan;		! Channel for reading font files;

! For each font, we keep a record containing all its information.  The array
  DATA in the record is allocated when the font is read in.  The font records
  are linked together in a list by the NEXT field, with the most recently
  used font always moved to the head of the list and pointed to by
  CURRENT_FONT.;

record_class font (
    record_pointer(font) next;	! Next font in list;
    integer fontnumber;		! -1 for preloaded fonts;
    integer file_type;		! PXL or TFM;
    integer length;		! Number of words in DATA;
    string filename;		! WAITS name of file this font came from;
    saf integer array data	! Will be [0:LENGTH-1];
   );

record_pointer(font) current_font;
define preloaded = -1;

! CURRENT_FONT is a record pointer to the record for the current font.  However,
  for the sake of efficiency we let CURRENT_FONT_PTR be the location of the DATA
  array for the current font.  Also, we let CURRENT_FONT_DATA be the address of
  the first word in the character information table at the end of the DATA
  array.  CURRENT_FONT_TYPE is either PXL or TFM.;

integer current_font_ptr, current_font_data, current_font_type;

! FIND_FONT looks for a font with a given fontnumber.  If it is found,
  CURRENT_FONT, CURRENT_FONT_PTR, CURRENT_FONT_DATA, and CURRENT_FONT_TYPE are
  set, and TRUE is returned.  If it is not found, and the second parameter is
  FALSE, then an error message is generated.;

boolean procedure find_font(integer fontnumber; boolean just_checking(false));
    begin "find_font"
    record_pointer(font) p,q;

    p ← null_record;
    q ← current_font;
    while q ≠ null_record do begin "look"
	if font:fontnumber[q] = fontnumber then begin "found"
	    if p ≠ null_record then begin
		font:next[p] ← font:next[q];
		font:next[q] ← current_font;
		current_font ← q;
		end;
	    current_font_ptr ← location(font:data[q][0]);
	    current_font_data ← current_font_ptr + font:length[q] - 517;
	    current_font_type ← font:file_type[q];
	    return(true);
	    end "found";
	p ← q;
	q ← font:next[q];
	end "look";
    if just_checking then return(false);
    error("Font " & cvs(fontnumber) & " used but never defined");
    end "find_font";

! READ_FONT_FILE tries to read a PXL file for a given fontnumber.  It assumes
  that FONTCHAN has been opened already.  We look on the directory given by
  PXLPPN, unless the DVI file specifies a different directory.  If it is not
  found there, we look for the TFM file instead.  If neither is present, we
  print a warning and set a flag so that we won't try to process the body of the
  DVI file, but continue so that all non-existent font files can be noticed.

  We preprocess the Directory Information of a PXL file so that "halfwords",
  which are 16 bits long, are made into real PDP-10 halfwords (with sign
  extension), and change the fourth word, which is the character width in FIXes,
  to its width in DVI file units, which involves multiplying by a constant that
  depends on the magnification.  This is done so that the SET_CHAR procedure
  will not have to do it each time it is called.

  Upon return, CURRENT_FONT points to the font we have just read in.;

procedure read_font_file(integer fontnumber; string fontname;
	real mag; integer cksum);
    begin "read_font_file"
    string filename,pxl_filename,s;
    integer extension;		! Filename extension for PXL file;
    real    fmult;		! RSUs per FIX for this font;
    integer flength;		! Length of data in font file;
    integer font_cksum;		! Checksum in font file;
    integer file_type;		! PXL or TFM;
    record_pointer(font) new_font, p;
    label pre_process;

    ! We compute the extension of the font file from the magnification.  For an
      unmagnified font, say CMR10, the file will be "CMR10.350" since the full
      name is "CMR10.350PXL".  When the name contains more than three digits,
      character codes higher than "9" are used for the leftmost character.
      E.g., CMR10 at 30pt, which is "CMR10.1050PXL", will be "CMR10.:50".;
    extension ← (PixelsPerInch * mag * magnification / 200.0);
    filename ← fontname;	! Preserve FONTNAME for error msg;
    s ← scan(filename,file_hack,brchar);
    if length(s) > 6 then s ← s[1 to 3] & s[∞-2 to ∞];
    filename ← s & filename;
    scan_filename(filename,false);	! Leave PPN intact;
    if farray[1] = "" then farray[1] ← "."
	  & (extension div 100 + "0")
	  & (extension mod 100 div 10 + "0")
	  & (extension mod 10 + "0");

    ! Use PPN given in PXL_FNAME, if any, else PXLPPN.;
    file_type ← pxl;
    filename ← farray[0] & farray[1] & farray[2];
    if equ(farray[2],null) then filename ← filename & pxlppn;

    ! See if we already have a font with this name (presumably preloaded).;
    p ← current_font;
    while p ≠ null_record do
	if equ(font:filename[p],filename) then begin "got it"
	    if font:fontnumber[p] ≠ preloaded then begin "kludge"
		! This happens when the same font is given two different
		  font numbers by TeX (e.g., "cmr10" and "CMR10").  Our
		  solution is to create a new font record, but have the data
		  array point to the existing data array.;
		new_font ← new_record(font);
		font:fontnumber[new_font] ← fontnumber;
		font:file_type[new_font] ← font:file_type[p];
		font:length[new_font] ← font:length[p];
		font:filename[new_font] ← font:filename[p];
		memory[location(font:data[new_font])] ← memory[location(font:data[p])];
		font:next[new_font] ← current_font;
		current_font ← new_font;
		! The data in the array must have already been preprocessed,
		  so we are done.;
		return
		end "kludge";
	    font:fontnumber[p] ← fontnumber;
	    if not find_font(fontnumber,true)	! this sets CURRENT_FONT;
		then error("Impossible font error - find a wizard");
	    flength ← font:length[p];
	    font_cksum ← font:data[p][flength-5] lsh -4;
	    go to pre_process
	    end "got it"
	else p ← font:next[p];

    ! Look for the font with the given filename.;
    if fontnumber ≠ preloaded and not reading_fonts then begin
	reading_fonts ← true;
	print("Reading fonts ..." & ↓);
	end;
    lookup(fontchan,filename,flag);

    if flag then begin
	! Couldn't find PXL file.  Look for TFM file on PPN given in FILENAME,
	  if any, else on TFMPPN (except when preloading).;
	pxl_filename ← filename;		! For error message;
	if fontnumber ≠ preloaded then begin
	    file_type ← tfm;
	    filename ← farray[0] & ".TFM" & farray[2];
	    if farray[2] = "" then filename ← filename & tfmppn;
	    lookup(fontchan,filename,flag);
	    if flag then all_done ← true;	! We're going to quit;
	    end;
	setformat(0,3);
	print("Couldn't find font ",fontname,
	    " at magnification",cvf(mag*magnification/1000.),
	    " (file ",pxl_filename,")." & ↓);
	if not flag then print("  Will read character widths from TFM file." & ↓);
	end;

    ! If we failed to find either a PXL or TFM file, either just now, or
      previously, we return here since we're never going to get past the
      postamble.;
    if all_done then return;

    if fontnumber ≠ preloaded and find_font(fontnumber,true) then
	error("Font " & fontnumber & " defined more than once");
    flength ← filesize;

    ! Create a record for the font;
    new_font ← new_record(font);
    font:fontnumber[new_font] ← fontnumber;
    font:filename[new_font] ← filename;
    font:length[new_font] ← flength;
    font:file_type[new_font] ← file_type;
    font:next[new_font] ← current_font;
    current_font ← new_font;

    ! Create an array to hold the font information (SAIL manual, p. 65);
    memory[location(font:data[current_font])] ← armak(0,flength-1,1);

    arryin(fontchan,font:data[current_font][0],flength);
    close(fontchan);
    current_font_ptr ← location(font:data[current_font][0]);

    ! Unfortunately we cannot preprocess preloaded fonts, since UNITSCALE is
      not defined at that time.  So preprocessing will be done when the font
      is actually used.;

    if fontnumber = preloaded then return;

pre_process:
    if file_type = pxl then begin "pxl preprocessing"
	! Compute the multiplier for this font;
	fmult ← (font:data[current_font][flength-3] ash -4)  ! design size in fixes;
	    * mag * (2.54*100000.) / (2.0↑40*72.27*unitscale);

	! Do the preprocessing on the font data;
	current_font_data ← current_font_ptr + flength - 517;
	start_code "convert"
	    define a=1, b=2, x=3, y=4;
	    label loop;
	    movei a,128;		! Number of characters left to do;
	    move b,current_font_data;	! Addr of 1st word of current char;

    loop:   move x,0(b);
	    move y,x;
	    ash x,-20;			! X ← pixel width;
	    lsh y,16;
	    ash y,-20;			! Y ← pixel height;
	    hrl y,x;			! Merge into Y;
	    movem y,0(b);		! Store it away;

	    move x,1(b);
	    move y,x;
	    ash x,-20;			! X ← x offset;
	    lsh y,16;
	    ash y,-20;			! Y ← y offset;
	    hrl y,x;			! Merge into Y;
	    movem y,1(b);		! Store it away;

	    move x,2(b);
	    ash x,-4;			! X ← character starting word in DATA;
	    movem x,2(b);		! Store it;

	    move x,3(b);
	    ash x,-4;			! X ← character width in FIXes;
	    fltr x,x;			! Multiply by FMULT in floating point;
	    fmpr x,fmult;
	    fixr x,x;			! X ← character width in RSUs;
	    movem x,3(b);		! Store it;

	    addi b,4;			! Index for next character;
	    sojg a,loop;		! See if we're done;
	    end "convert";

	font_cksum ← font:data[current_font][flength-5] lsh -4;
	end "pxl preprocessing"
    else if file_type = tfm then begin "tfm preprocessing"
	! The only interesting information in the TFM file is the character
	  widths.  After the following preprocessing is done, word 0 of the data
	  array will contain LH, word 1 will contain BC, word 2 will contain EC,
	  and words 6+LH through 6+LH+(EC-BC) will contain the widths of
	  characters BC through EC, in rsu's.  (See the description of TFM files
	  for the definition of all the 2-letter variables used here.);
	fmult ← (font:data[current_font][7] ash -4)	! design size in fixes;
	    * mag * (2.54*100000.) / (2.0↑40*72.27*unitscale);

	start_code "convert"
	    define a=1, b=2, c=3, d=4, x=5;
	    label loop;
	    movsi a,'242000;
	    add a,current_font_ptr;	! Byte ptr to LF;
	    ildb b,a;			! B ← LH;
	    ildb c,a;			! C ← BC;
	    ildb d,a;			! D ← EC;
	    move a,current_font_ptr;
	    movem b,0(a);
	    movem c,1(a);
	    movem d,2(a);
	    addi a,6(b);		! A ← ptr to start of char_info;
	    move b,a;
	    addi b,1(d);
	    sub b,c;			! B ← ptr to start of widths;

	    subi c,1(d);
	    hrl a,c;			! set up for AOBJN;
    loop:   move x,0(a);		! char_info word;
	    lsh x,-28;			! width index;
	    add x,b;
	    move x,0(x);		! word from width table;
	    ash x,-4;			! X ← character width in FIXes;
	    fltr x,x;			! Multiply by FMULT in floating point;
	    fmpr x,fmult;
	    fixr x,x;			! X ← character width in RSUs;
	    movem x,0(a);		! Store it;
	    aobjn a,loop;
	    end "convert";
	font_cksum ← font:data[current_font][6] lsh -4;	! header[0];
	end "tfm preprocessing";

    ! Verify the font checksum, unless not required to;
    if cksum and font_cksum and (cksum ≠ font_cksum) then
	print("Checksum mismatch for font ",filename,↓);

    end "read_font_file";

! PRELOAD_FONTS reads in font files and sets up the core image to be saved, so
  that this doesn't have to be done every time the program is run.;

simple procedure preload_fonts;
    begin "preload_fonts"
    define num_fonts = 17;
    preload_with "AMR10","AMR9","AMR8","AMR7","AMR5","AMMI10","AMMI7",
	"AMMI5","AMSY10","AMSY7","AMSY5","AMEX10","AMTI10","AMSL10",
	"AMBX10","AMTT10","MANFNT";
    saf own string array font_name[1:num_fonts];
    integer i;

    magnification ← default_mag;
    open(fontchan←getchan,"dsk",'17,0,0,0,brchar,eof);
    for i ← 1 thru num_fonts do begin "preload a font"
	print("Preloading ",font_name[i],↓);
	! All fonts currently preloaded are at magnification 1.0 * default_mag;
	read_font_file(preloaded,font_name[i],1.0,0);
	end "preload a font";
    print(if all_done then "
Something went wrong.  Please fix things and try again.
" else "
Ready to save the core image.
");
    magnification ← 0;
    release(fontchan);
    if not all_done then ptostr(0,"save sys dvidd");
    end "preload_fonts";